<> <<uicode>> * PROWINDO.TLB * This library does windows. * Last modified 12/19/89 ******************************* function declare_all_windows ** ******************************* * Modified from a previously issued WallSoft function of the same name for all boxes where at("WINDOW", upper(box.descrip) ) declare_window(box) next return ************************** function declare_window ** ************************** param b private n, ol, has_border has_border = b.outline.type n = substr(box.name,1,10) ? "DEFINE WINDOW {n} FROM {b.row}, {b.col} TO {b.bottom}, {b.right}" if has_border if at("PANEL", upper(b.slot1)) ?? " PANEL ;" else ol = b.outline.string ?? " '{ol[2]}','{ol[6]}','{ol[8]}','{ol[4]}'," ?? "'{ol[1]}','{ol[3]}','{ol[7]}','{ol[5]}' ;" endif if b.height >1 .and. strange_outline(b,0) ? '{write_window_title(b)} ;' endif else ** it's a no-outline box ?? " NONE ;" endif if ! empty(b.slot2) ? '{b.slot2} ;' endif ? "COLOR {b.contents.color},,{iif(has_border, b.outline.color, "")}" ? return ****************************** function write_window_title ** ****************************** param b private tline, msgstr, title, tokes, i tline = box_text(b,0,0) tokes = get_tokens("{tline}" ," [ ] Ä Í " ) msgstr = "" for i = 1 to len(tokes) if isalpha({tokes[i]}) .or. at({tokes[i]}, "[ ]") msgstr= msgstr + " " + tokes[i] endif next msgstr = alltrim(msgstr) if len(msgstr) title = 'TITLE "{msgstr}" ' else title = "" endif return title ***************************** function write_window_text ** ***************************** param b private wr,wc,i wr = 0 wc = 0 for i = 1 to b.height - iif(b.outline.type, 2, 0) if b.outline.type if len(alltrim({box_text(box,{wr+1},{wc+1},b.width -2)})) ? '@ {wr},{wc} SAY ; {digest_text(box_text(box,{wr+1},{wc+1},b.width -2))}' endif else if len(alltrim({box_text(box,{wr},{wc},b.width)})) ? '@ {wr},{wc} SAY ; {digest_text(box_text(box,{wr},{wc},b.width ))}' endif endif wr++ next return ********************** function munch_slot ** ********************** * breaks a long Slot expression where the developer entered a semi-colon param sl private s_tokes,i s_tokes = get_tokens("{sl}", " ; ") for i = 1 to len(s_tokes) ?? "{s_tokes[i]} " if s_tokes[i] = ";" ? endif next return *********************** function digest_text ** *********************** * a WallSoft genuine original param s private i,lquote,rquote if at('"',s) if at("'",s) if at("[",s) .or. at("]",s) s=strtran(s,'"','"+%'"%'+"') lquote='"' rquote='"' else lquote='[' rquote=']' endif else lquote="'" rquote="'" endif else lquote='"' rquote='"' endif s=lquote+s+rquote if ctrl_in_str(s) if asc(s[2])<32 s = "chr("+asc(s[2])+")+"+lquote+substr(s,3) endif if asc(s[len(s)-1])<32 s = substr(s,1,len(s)-2)+rquote+"+chr("+asc(s[len(s)-1])+")" endif for i=3 to len(s)-2 if asc(s[i])<32 ** break control char into '...+chr(n)+...' format s=substr(s,1,i-1)+rquote+"+chr("+asc(s[i])+")+"+lquote+substr(s,i+1) i=i+7+(asc(s[i])>9) endif endfor s=strtran(s,'+{lquote}{rquote}+','+') endif return s ***************************** function get_var_in_window ** ***************************** * Modified from a previously issued WallSoft function of the same name param w,v private vr,vc, has_border has_border = box.outline.type if has_border vc = v.col - w.col -1 vr = v.row - w.row -1 else vc = v.col - w.col vr = v.row - w.row endif ? "@ {vr}, {vc} GET {var_get_name(v)}" if v.picture ??" PICTURE {v.picture}" endif if v.color ?? " COLOR ,{v.color}" endif if v.range ??" RANGE {v.range}" endif if .not. empty(v.valid) ?? " VALID " ** I've had second thoughts about this: ** If you take out this line, you have a ** choice of whether to use a VALID ** in a GET or not. You have to supply ** the keyword VALID in the slot if you do ** take it out, but it's better that way. ** This way assumes you'll always have a ** VALID clause, which is bogus. In fact ** if you don't have a VALID clause, the ** generated code, when run, will probably ** go huli if you leave this in. ** this in. ** Captain Afterthought strikes again. munch_slot(v.valid) endif return *************************** function box_wants_input ** *************************** for all vars in box if var.input return .T. endif endfor ************************ function var_get_name ** ************************ * Genuine WallSoft original param v private name if v.isfield .and. number_of_dbfs() > 1 name = iif( empty( (v.dbf).alias ), (v.dbf).name, ; (v.dbf).alias )+ '->' + v.name else if at("(",v.name) .or. at(")",v.name) gen_msg("Warning: {v.name} is NOT a simple variable. "+; "I'm about to generate @..GET code for it. "+; "This code may be erroneous.") endif name=v.name endif return name ************************************ function get_field_dupe_in_window ** ************************************ * Modified from a WallSoft function of the same name param w,v private vr,vc if box.outline.type ** has a border, adjust box arithmetic vc = v.col - w.col -1 vr = v.row - w.row -1 else ** a no-border window, use UI2 box arithmetic vc = v.col - w.col vr = v.row - w.row endif ? "@ {vr}, {vc} GET {dupe_name(v)}" do case case v.picture ??" PICTURE {v.picture}" case v.type = 'N' ?? " PICTURE '" if v.decimal >0 ?? "0."+replicate("0",v.decimal) else ?? replicate("0",v.length) endif ?? " '" endcase if v.range ??" RANGE {v.range}" endif if .not. empty(v.valid) ?? " VALID " munch_slot(v.valid) endif return ***************************** function say_var_in_window ** ***************************** * Modified from a WallSoft function of the same name param w,v private vr,vc, has_border has_border = box.outline.type if has_border vc = v.col - w.col -1 vr = v.row - w.row -1 else vc = v.col - w.col vr = v.row - w.row endif ? "@ {vr}, {vc} SAY {var_say_name(v)}" if v.picture ??" PICTURE {v.picture}" endif return ************************* function var_say_name ** ************************ * A genuine WallSoft original param v private name, areaptr if v.isfield .and. number_of_dbfs() > 1 if .not. empty(v.display_formula) name = v.display_formula if .not. at(lower(v.name),lower(v.display_formula)) gen_msg("Warning: can't find variable name '{v.name}' within "+; "display_formula ({v.display_formula}). The display_formula "+; "will be used in an @..SAY statement. Code may be erroneous.") else areaptr = iif( empty((v.dbf).alias), (v.dbf).name, (v.dbf).alias)+; '->' name = strtran( name, v.name, areaptr+v.name ) endif else name = iif( empty((v.dbf).alias), (v.dbf).name, (v.dbf).alias )+; '->' +; v.name endif else if .not. empty(v.display_formula) name=v.display_formula else name=v.name endif endif return name ************************ function var_init_val ** ************************ * A genuine WallSoft Original param v do case case v.init_val return v.init_val case v.type = 'C' return "SPACE({v.length})" case v.type = 'N' if v.decimal >0 return "0."+replicate("0", v.decimal) else return replicate("0",v.length) endif case v.type = 'L' return ".F." case v.type = 'D' return "CTOD(' / / ')" endcase return ********************* function dupe_name ** ********************* * A genuine WallSoft original param f, pflet private fname if pcount() < 2 .or. !pflet fname = "m" + substr(f.name,1,9) else if at("->", pflet) fname = pflet + f.name else fname = pflet + substr(f.name,1, 10-len(pflet)) endif endif return fname ******************************* function declare_field_dupes ** ******************************* * A genuine WallSoft original param pflet if pcount() = 0 pflet = "m" endif declare_prefix_in_box(pflet) return ********************************* function declare_prefix_in_box ** ********************************* * A genuine WallSoft original param pflet, b private stmt private firstvar private stmtlen private memname,abox abox = pcount() > 1 firstvar = .t. stmtlen = 0 stmt = "" for all fields loop when abox .and. field.owner <> b memname = dupe_name(field, pflet) if stmtlen >= 65 ? stmt firstvar = .t. endif if firstvar stmt = "PRIVATE " + memname firstvar = .f. stmtlen = len(stmt) else stmt = stmt + ", " + memname stmtlen = stmtlen + 2 + len(memname) endif endfor ? stmt return ************************* function init_all_dbfs ** ************************* * A genuine WallSoft original param dbfpathvar, indexpathvar, check private i, primary_specified, nargs nargs = pcount() check_areas() path_setup(nargs) * Note that 'for all dbfs' only sees DBFs used in form for all dbfs selectNuse(dbf,dbfpathvar,indexpathvar,check) endfor * Set relation code ? for all dbfs set_rels(dbf) endfor * if more than one DBF is selected if number_of_dbfs() >1 primary_specified = .f. for all dbfs where dbf.primary select_alias(dbf) primary_specified = .t. next if .not. primary_specified ?'SELECT 1' endif endif return ********************** function path_setup ** ********************** * A genuine WallSoft original param nargs switch nargs case 0 dbfpathvar = "" indexpathvar = "" check = .f. case 1 dbfpathvar = "&{dbfpathvar}." indexpathvar = "" check = .f. case 2 dbfpathvar = empty(dbfpathvar) ? "" : "&{dbfpathvar}." indexpathvar = "&{indexpathvar}." check = .f. case 3 dbfpathvar = empty(dbfpathvar) ? "" : "&{dbfpathvar}." indexpathvar = empty(indexpathvar) ? "" : "&{indexpathvar}." endsw return ********************** function selectNuse ** ********************** * A genuine WallSoft original param thisdbf, dbfpath, indexpath, check private i, dname ? "* Open database {thisdbf.name}" if .not. empty(thisdbf.alias) ?? " (alias {thisdbf.alias})" endif if len(thisdbf.indexes) > 0 ? "*" ? "* Indexes used:" for i = 1 to len(thisdbf.indexes) ? "* {i}: {thisdbf.indexes[i].name} ('{thisdbf.indexes[i].expr}')" next endif ? "*" if thisdbf.area ?"SELECT {thisdbf.area}" else ?"SELECT 1" endif ?"USE {dbfpath}{striptag(thisdbf.name)}" if thisdbf.alias ??" ALIAS ", thisdbf.alias else dname = upper(striptag(stripdir(thisdbf.name))) for all dbfs n = len(dbf.relations) for i = 1 to n exit when upper(dbf.relations[i].name) = dname endfor exit when i <= n endfor if i <= n ??" ALIAS {dname}" endif endif if check .and. len(thisdbf.indexes) > 0 ? "* first, check the existence of needed indexes" for i = 1 to len(thisdbf.indexes) ?'IF .not. file("{indexpath}{thisdbf.index[i].name}{ndxtag}")' ?" INDEX ON {thisdbf.index[i].expr} TO "+; "{indexpath}{thisdbf.index[i].name}{ndxtag}" ?"ENDIF" next ? ? "* now SET INDEX" ? for i = 1 to len(thisdbf.indexes) ?? "{iif(i = 1, "SET INDEX TO ", ",")} {indexpath}{thisdbf.index[i].name}" next else for i = 1 to len(thisdbf.indexes) ?? "{iif(i = 1, " INDEX ", ",")} {indexpath}{thisdbf.index[i].name}" next endif return ******************** function set_rels ** ******************** * A genuine WallSoft original param thisdbf private i, reldbf, thisname, ndicdbfs, ndbfs if len(thisdbf.rel) = 0 return endif ?"* relation code for ", thisdbf.name select_alias(thisdbf) ndicdbfs = len(dicdbf_array) ndbfs = len(dbf_array) for i = 1 to len(thisdbf.rel) ? "SET RELATION " ?? "TO " ?? thisdbf.rel[i].expr ?? " INTO " reldbf = 0 thisname = thisdbf.rel[i].name for j = 1 to ndbfs if dbf_array[j].name = thisname reldbf = dbf_array[j] exit endif next if .not.reldbf for j = 1 to ndicdbfs if dicdbf_array[j].name = thisname reldbf = dicdbf_array[j] exit endif next endif if .not.reldbf gen_error("{thisdbf.name} related file: {thisname} not in dictionary") endif ?? iif(.not. empty(reldbf.alias), reldbf.alias, reldbf.name) if i > 1 ??" ADDITIVE" endif next return *********************** function check_areas ** *********************** * A genuine WallSoft original private areas areas = array('DBF',10) for all dbfs if dbf.area > 0 .and. dbf.area <= 10 if areas[dbf.area] gen_error("DBF {areas[dbf.area].name} ; has same area number as {dbf.name}") else areas[dbf.area] = dbf endif endif endfor return ************************ function select_alias ** ************************ * A genuine WallSoft original param d ? "SELECT {alias(d)}" return ***************** function alias ** ***************** * A genuine WallSoft original param d return (empty(d.alias) ? d.name : d.alias) ******************** function init_var ** ******************** * A genuine WallSoft original param v private iv,isfld,vn if .not. v.input .and. empty(v.init_val) return endif iv = var_init_val(v) isfld = (type(v) = "FIELD" || (type(v) = "VAR" && v.isfield)) vn = build_var_name(v) if isfld ? "REPLACE {vn} WITH {iv}" else ? "{vn} = {iv}" endif return ************************** function build_var_name ** ************************** * A genuine WallSoft original param v private vn if number_of_dbfs() > 1 .and. v.isfield vn = (empty(v.dbf.alias) ? v.dbf.name : v.dbf.alias) + "->" + v.name else vn = v.name endif return vn <<enduicode>>